
# Printing to file

writetofile := proc(filename, text)
  local fd, i;
  fd := fopen(filename, WRITE, TEXT):
  for i from 2 to nargs do fprintf(fd, "%Q\n", args[i]); end do;
  fclose(fd);
end:

write2ft := proc(filename, text)
  # write to file and terminal
  local fd, i;
  fd := fopen(filename, WRITE, TEXT):
  for i from 2 to nargs do 
    printf ("%Q\n", args[i]);
    fprintf(fd, "%Q\n", args[i]); 
  end do;
  fclose(fd);
end:


appendtofile := proc(filename, text)
  local fd, i;
  fd := fopen(filename, APPEND, TEXT):
  for i from 2 to nargs do fprintf(fd, "%Q\n", args[i]); end do;
  fclose(fd);
end:

append2ft := proc(filename, text)
  # append to file and terminal
  local fd, i;
  fd := fopen(filename, APPEND, TEXT):
  for i from 2 to nargs do 
    printf ("%Q\n", args[i]); 
    fprintf(fd, "%Q\n", args[i]); 
  end do;
  fclose(fd);
end:

DebugReport := proc()
  if detailedReportFile <> "" then
    appendtofile(detailedReportFile, args);
  else
    printf("\nDebugReport: %Q\n", args);
  fi;
end proc:


# sorting proc for RESOLVE result
ResolveSizer := proc (x)
  description "Sorts resolve results by size, linear cases first" ;
  if nops(x)=3 then 
    (size(x[2])*1e8-1e8)*(size(x[1]*x[3]) + size(x[1])/1000000+size(x[3])/100000) # linear case
    #size(x[1]*x[3]) + size(x[1])/10000+size(x[3])/100
  else 
    infinity # nonlinear case
  fi  
end:

# getting unknowns of specifyed expression
sortedUnks := proc (expr)
  description "Returns  `unk/<</list` union (unks(expr) minus `unk/<</list`)";
  # maple predefined union and minus is unusable becouse operates on sets only, 
  # the order is important here  
  [ op(`unk/<</list`), 
    op( map (proc (x) if not x in `unk/<</list` then x fi end proc, unks(expr)))
  ]
end proc:

# Generators of .runme file:

GenerateResultFiles := proc (basefilename, StateFilesDir, RunMeFilesDir)
  description "Generates result files when Run() failed";
  # StateFilesDir: dir path to the States dir relative to pwd of .mc whitch reads generated .runme file, usually  "global/States/"
  # RunMeFilesDir: relative path to dir where .runme files are to be stored, usually  "Ready/"	
	GenerateFailedResultFiles(basefilename, StateFilesDir, RunMeFilesDir, 0); 
end:

GenerateFailedResultFiles := proc(basefilename, StateFilesDir, RunMeFilesDir, stepnumber)
  local resolveResult, sortedFailedResolve, failedResult, a1, b1, x1 ;
  printf("----------------------------------------\nResolve failed at level %a.\n", stepnumber);
  #printf("RESOLVE=%a\n", RESOLVE);
  #print(RESOLVE);
  sortedFailedResolve := sizesort(convert(RESOLVE,'list'), ResolveSizer);
  # melo by se vyjmout jen to linearni a to stridit at se nepocityji zbytecne velikosti nelinearnich veci
  DebugReport(sprintf("GenerateFailedResultFiles(%a): sorted RESOLVE=%Q", stepnumber, sortedFailedResolve));
	printf("***** sortedFailedResolve: *****");
	map (
	 proc (x) 
	   local x3;
	   if nops(x)=3 then
       printf("\n* linear: \n");
       printf("sizes: size(x[1])=%a, size(x[2])=%a, size(x[3])=%a, size(x[1]*x[3])=%a, ResolveSizer(x)=%q\n", 
              size(x[1]), size(x[2]), size(x[3]), size(x[1]*x[3]), ResolveSizer(x)) ; 

       lprint("x[1]"=x[1]);
       lprint("x[2]"=x[2]);
       lprint("x[3]"=x[3]);
	   else 
      printf("\n* NONlinear\n");
      lprint("x[1]"=x[1]); 
      lprint("x[2]"=x[2]);
      fi;
	 end proc, 
	 sortedFailedResolve);
	printf("***** end of sortedFailedResolve listing *****\n");
	failedResult := sortedFailedResolve[1];
	#printf("failedResult=%a\n\n", failedResult);
	if nops(failedResult)=2 then
      # nonlinear failure
      a1:=failedResult[1];
      printf("NONLINEAR failure,\nlets generate NONZERO result files based on the expression E%a:\n", stepnumber);
      print(a1); 
      printf("E%a=%q\n", stepnumber, a1);
      GenerateNonZeroFile(a1, basefilename, StateFilesDir, RunMeFilesDir, stepnumber);  
      
      if type(a1, nonzero) then
        printf("\ntype(E, nonzero)=true\nNonlinear failere is skipped.\n");
      else  
        GenerateNonLinFailFile(sortedFailedResolve, basefilename, StateFilesDir, RunMeFilesDir, stepnumber+1);
      fi;
	else
      # linear failure 
      a1:=failedResult[1];
      b1:=failedResult[3];
      x1:=failedResult[2]; 
      printf("Lets generate result files based on the expression E%a:\n", stepnumber);
      print(a1); 
      printf("E%a=%q\n", stepnumber, a1);
      GenerateNonZeroFile(a1, basefilename, StateFilesDir, RunMeFilesDir, stepnumber);  
      GenerateNextResultFiles(a1, basefilename, StateFilesDir, RunMeFilesDir, stepnumber+1);
    fi;      
end:

GenerateNextResultFiles := proc(expr, basefilename, StateFilesDir, RunMeFilesDir, stepnumber)
  local resolveResult, u, ratio;
  global ressize, putsize, maxsize;

  printf("\n----- %a\nresolve(E%a)", stepnumber, stepnumber);
  u := `unk/<</list` ; # store actually used unknowns
  try
    unknowns(op(sortedUnks(expr))); # use unknowns from expression to be resolved
    resolveResult := resolve(expr); 
    
    if evalb(`resolve/result/type`='Fail') 
        and evalb(`resolve/result/suppressedminsize` <> NULL) then
      
      ratio := `resolve/result/suppressedminsize`/maxsize*2;
      
      printf("\nTrying to increase sizes by ratio %a:\n", ratio);
      printf("resolve(E%a)",stepnumber);
      
      ressize := trunc(ressize*ratio);  putsize := trunc(putsize*ratio);  maxsize := trunc(maxsize*ratio);
      
      resolveResult := resolve(expr);

    fi;

    printf("=\n");
    print(resolveResult);    
  catch "no unknowns":
    resolveResult := (expr=0);
    printf("\n%q\n", lastexception);
    printf("Resolve reported \"no unknowns\" failure, lets try just put(%a):\n", resolveResult);     
  catch "there are contradictory equations":
    resolveResult := 'CE' ;
    printf("there are contradictory equations.\n");
  finally 
    unknowns(op(u)); # restore originally used unknowns  
  end try;
  
  if resolveResult = FAIL then
    GenerateFailedResultFiles(basefilename, StateFilesDir, RunMeFilesDir, stepnumber); 
  elif  resolveResult = 'CE' then
    print("1=0, nothing to do.");
  else
    GeneratePutZeroFile(resolveResult, basefilename, StateFilesDir, RunMeFilesDir, stepnumber);  	  
    # GeneratePutZeroFile(x1=b1/a1, basefilename, StateFilesDir, RunMeFilesDir, stepnumber);
  fi;
end:

GenerateNonZeroFile := proc (resolvedExpr, basefilename, StateFilesDir, RunMeFilesDir, stepnumber) 
  global ressize, putsize, maxsize;
  local fileName ;
  fileName := cat(RunMeFilesDir, basefilename, sprintf("%s", WrapNumber(stepnumber*2+1)), ".runme") ;
  printf("Generating nonzero file %s: nonzero(E%a);\n", fileName, stepnumber) ;
  writetofile (fileName, 
    sprintf("%A\n%A\n%A\n# Done", 
      cat("read( """, StateFilesDir, basefilename, ".state"" ); "),
      cat("nonzero( ", sprintf("%a", resolvedExpr), "); "),
      sprintf("ressize := %a; putsize := %a; maxsize := %a;\n", ressize, putsize, maxsize)));
end:

GeneratePutZeroFile := proc (resolvedExpr, basefilename, StateFilesDir, RunMeFilesDir, stepnumber) 
  global ressize, putsize, maxsize;
  local fileName ;
  fileName := cat(RunMeFilesDir, basefilename, sprintf("%s", WrapNumber(stepnumber*2)), ".runme") ;
  printf("Generating putzero file %s: put(%a); \n", fileName, resolvedExpr) ;
  writetofile (fileName, 
    sprintf("%A\n%A\n%A\n# Done",
      cat("read( """, StateFilesDir, basefilename, ".state"" ); "),
      cat("put( ", sprintf("%a", resolvedExpr), "); "),
      sprintf("ressize := %a; putsize := %a; maxsize := %a;\n", ressize, putsize, maxsize)));
end:

GenerateContinueFile := proc (basefilename, StateFilesDir, RunMeFilesDir, stepID, ContinuingCommand) 
  global ressize, putsize, maxsize;
  local fileName ;
  fileName := cat(RunMeFilesDir, basefilename, stepID, ".runme") ;
  printf("Generating continue file %s: %A \n", fileName, ContinuingCommand) ;
  writetofile (fileName, 
    sprintf("%A\n%A\n%A\n# Done",
      cat("read( """, StateFilesDir, basefilename, ".state"" ); "),
      sprintf("ressize := %a; putsize := %a; maxsize := %a;\n", ressize, putsize, maxsize),
      ContinuingCommand));
end:

GenerateNonLinFailFile := proc (sortedResolve, basefilename, StateFilesDir, RunMeFilesDir, stepnumber) 
  global ressize, putsize, maxsize;
  local fileName ;
  fileName := cat(RunMeFilesDir, basefilename, WrapNumber(stepnumber*2+2), ".nonlinfail") ;  
  printf("\n*****\nNonlinear failure!!!\nGenetating %a\nsortedResolve=%a\n", fileName, sortedResolve);
  writetofile (fileName, 
    sprintf("#sortedResolve=%a\n%A\n%A\nprint(\"And what now?\");\n",
      sortedResolve,
      cat("read( """, StateFilesDir, basefilename, ".state"" ); "),
      sprintf("ressize := %a; putsize := %a; maxsize := %a;\n", ressize, putsize, maxsize)));
      
  # TODO: Handle nonlinear failure correctly!    
end:

WrapNumber := proc(number)
  description "Returns numeric argument as a string wrapped by {} when >=10";
  if number > 9 then sprintf("{%a}", number) else  sprintf("%a", number) fi
end :



###
### Auxiliary  procedures
###

ReportSuccessState := proc(parBaseFileName) 
	description "Reports jets's state in human readable format to given file and to terminal";
	local filename, title;
  if nargs>1 then title := args[2] else title := "" fi;
	
	# report to terminal
  PrintSuccessReport(title);
  
  if nargs >= 2 then
    # report to file Results/<parBaseFileName>.success
    filename := cat("Results/", parBaseFileName, ".success");	
    try
      appendto(filename);   
      PrintSuccessReport(parBaseFileName, title);
    finally
      writeto(terminal);
    end try;
	fi;
end: 

PrintSuccessReport := proc (parBaseFileName)
  local title;
  if nargs>1 then title := args[2] else title := "" fi;
  printf("\n--------------------\nSuccess report(%a): %Q\n", parBaseFileName, title);
  
  printf("Varordering=%a, ressize=%a, putsize=%a, maxsize=%a, ccmethod=%a, dmethod=%a, %a MB allocated.\n\n", 
           `Var/<</opt`,ressize, putsize, maxsize, ccmethod, dmethod, toMB(kernelopts(bytesalloc)));
  
  printf("\n*** dependence() =\n");
  print(    dependence()); 
  
  printf("\n***  nonzero() =\n");
  print(     nonzero()); 
  
  printf("\n*** \n");
  map(a -> printf("%a=%q\n", op(a), eval(op(a))), [indices(`dep/tab`)]);
      
  printf("\n*** cc()=\n");
  print(    cc());
  
  printf("\n*** map(normal@evalTD,[S]) =\n");
  print(    map(normal@evalTD,[S]));
  
  if assigned(PrintUserSuccessReport) then 
    printf("\n--------------------\n"); 
    try
      PrintUserSuccessReport(); 
    catch:
      printf("Warning, PrintUserSuccessReport() failed: %q\n", 
          StringTools[FormatMessage](lastexception[2..-1]));
    end:  
  fi;
    
  printf("\n-------------------- End of success report\n");
end proc:

# The user can define anywhere the custom report :
#
# PrintUserSuccessReport := proc()
#   print('A'=map(eval@simplify, op(A)));
#   print('B'=map(eval@simplify, op(B)));
# end:

sprintEV := proc (expr)
  description "returns string expr=value, where value is evaluated expr.";
  option inline;
  sprintf("%a=%q",'expr',eval(expr))
end proc:

printEV := proc(expr)
  description "prints expr=value, use [expr1, ..., exprn] for multiple arguments";
  option inline;
  `if` (type('expr',list),
    printf("%Q\n", op(map('sprintEV','expr'))),
    printf("%Q\n", sprintEV('expr')));
end proc:



ListUnion := proc ()
  map(op , [args])
end:




UpdateAliasSubs := proc()
global `dsolveMyZ/substitutions`;
  local aliaslist, maxdegree;
  aliaslist := [alias()];
  maxdegree :=  `if`( nargs>=1 and type(args[1],posint), min(args[1], nops(aliaslist)), min(9, nops(aliaslist))); 
  `dsolveMyZ/substitutions` := 
    map(
      proc(a) 
        local pa; 
        pa := parse(a,statement); 
        `if`(type (pa, specfunc(anything,jet)),pa=cat(a, _), NULL) # do not add dependent u_* to substitutions
      end, 
      [alias()][-maxdegree..-1])
end:

ConvertArgsDd := proc()
  description "Diff to diff vars conversion (jet u_x to unassigned u_x_)";
  global `dsolveMyZ/substitutions`;
  op(map(a -> 
          map(convert, a, diff, op(`dsolveMyZ/substitutions`)), 
        [args]));
end:


ConvertArgsdD := proc()
  description "diff to Diff vars conversion (unassigned u_x_ to jet u_x)"; 
  # conversion of jet vars implimented yet ONLY
  global `dsolveMyZ/substitutions`;
  op(map(a -> subs( op(map(a -> op(2,a) = op(1, a), `dsolveMyZ/substitutions`)), a), [args]));
end:

Dsolve := ConvertArgsdD@dsolve@ConvertArgsDd:
PDsolve := ConvertArgsdD@pdsolve@ConvertArgsDd:


`dsolveMyZ/timelimit` := 2: # limit in seconds for each single dsolve call
`dsolveMyZ/method` := Dsolve: # pdsolve also possible
`dsolveMyZ/printerrors` := false:

`dsolveMyZ/substitutions` := []:

dsolveMyZ := proc (Z)
  description "Try to dsolve the result of clear(pds)";
  global `dsolveMyZ/timelimit`, `dsolveMyZ/method`;
  local unknowns;
  unknowns := map2(op, 1, [dependence()]) ;
  print(op(map(ConvertArgsDd, unknowns)));
  # try dsolve all nonzero items of Z w. r. to all possible unknowns
  map(
      proc(ZZ) 
        local result;
        if simplify(ZZ) <> 0 then
          # take a nonzero item of Z
          if length(ZZ) < 500 then printf("***\n"); print(ZZ); else printf("*** Equation too long (%q).\n", length(ZZ)); fi;
          map (
            proc (unk)  
              try 
                # take an unknown
                result :=  timelimit(`dsolveMyZ/timelimit`, `dsolveMyZ/method`(ZZ, unk)); 
                printf("* %q\n", unk);
                print(result);
                result;
              catch "time expired":
                printf("* %q time expired\n", unk);
              catch : 
                if `dsolveMyZ/printerrors`=true then printf("* %a: %q\n", unk, StringTools[FormatMessage](lastexception[2..-1])); fi;
              end try; 
            end proc
            ,
            unknowns
            )    
        fi;
      end proc
    ,
    Z
  );
# map(x -> map(y -> print(op(1,y), map(z -> value(z), selectfun(op(2,y), Int))),x) , koko):

end proc: 



#
# Importantness of current state
#

ThrowExceptionWhenNonImportant := proc()
  description "Throws an exception when current state is unmimportant" ;
  local e ;
  e := TestOfNonImportantness();
  if e <> NULL then
     error "TestOfNonImportantness failed", e 
  fi
end proc:

TestOfNonImportantness := proc()
  description "Returns NULL if current state is important. Implicitly returns NULL everytime." ;
  ## by default, returns NULL every time (so everything is important)
  NULL
  ## Redefine this function to change importantness behavior
  ## Example:
  # local d;
  # d := `union`(op(map(vars,{A[1,1], A[1,2], A[2,2]} union {B[1,1], B[1,2], B[2,2]})));
  # if d subset {x,y} then
  #       print("TestOfNonImportantness failed, ", d);
  #       "Not enough variables." 
  # else
  #   print("TestOfNonImportantness ok, ", d);
  #   NULL
  # fi
  ##
end proc:
